{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, OverloadedStrings #-}
module Web.PathPieces
    ( PathPiece (..)
    , PathMultiPiece (..)
    , readFromPathPiece
    , showToPathPiece
    -- * Deprecated
    , toSinglePiece
    , toMultiPiece
    , fromSinglePiece
    , fromMultiPiece
    ) where

import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import qualified Data.Text as S
import qualified Data.Text.Lazy as L
import qualified Data.Text.Read
import Data.Time (Day)
import Control.Exception (assert)
import Text.Read (readMaybe)

class PathPiece s where
    fromPathPiece :: S.Text -> Maybe s
    toPathPiece :: s -> S.Text

instance PathPiece () where
    fromPathPiece :: Text -> Maybe ()
fromPathPiece Text
t = if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"_" then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing
    toPathPiece :: () -> Text
toPathPiece () = Text
"_"

instance PathPiece String where
    fromPathPiece :: Text -> Maybe String
fromPathPiece = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
S.unpack
    toPathPiece :: String -> Text
toPathPiece = String -> Text
S.pack

instance PathPiece S.Text where
    fromPathPiece :: Text -> Maybe Text
fromPathPiece = Text -> Maybe Text
forall a. a -> Maybe a
Just
    toPathPiece :: Text -> Text
toPathPiece = Text -> Text
forall a. a -> a
id

instance PathPiece L.Text where
    fromPathPiece :: Text -> Maybe Text
fromPathPiece = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
L.fromChunks ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return
    toPathPiece :: Text -> Text
toPathPiece = [Text] -> Text
S.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
L.toChunks

parseIntegral :: (Integral a, Bounded a, Ord a) => S.Text -> Maybe a
parseIntegral :: Text -> Maybe a
parseIntegral Text
s = Maybe a
n
    where
    n :: Maybe a
n = case Reader Integer -> Reader Integer
forall a. Num a => Reader a -> Reader a
Data.Text.Read.signed Reader Integer
forall a. Integral a => Reader a
Data.Text.Read.decimal Text
s of
        Right (Integer
i, Text
"") | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
top Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
bot -> a -> Maybe a
forall a. a -> Maybe a
Just (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i)
        Either String (Integer, Text)
_ -> Maybe a
forall a. Maybe a
Nothing
    Just a
witness = Maybe a
n
    top :: Integer
top = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
witness)
    bot :: Integer
bot = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
witness)

instance PathPiece Integer where
    fromPathPiece :: Text -> Maybe Integer
fromPathPiece Text
s =
        case Reader Integer -> Reader Integer
forall a. Num a => Reader a -> Reader a
Data.Text.Read.signed Reader Integer
forall a. Integral a => Reader a
Data.Text.Read.decimal Text
s of
            Right (Integer
i, Text
"") -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
            Either String (Integer, Text)
_ -> Maybe Integer
forall a. Maybe a
Nothing
    toPathPiece :: Integer -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

instance PathPiece Int where
    fromPathPiece :: Text -> Maybe Int
fromPathPiece = Text -> Maybe Int
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Int -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

instance PathPiece Int8 where
    fromPathPiece :: Text -> Maybe Int8
fromPathPiece = Text -> Maybe Int8
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Int8 -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Int8 -> String) -> Int8 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> String
forall a. Show a => a -> String
show

instance PathPiece Int16 where
    fromPathPiece :: Text -> Maybe Int16
fromPathPiece = Text -> Maybe Int16
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Int16 -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Int16 -> String) -> Int16 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> String
forall a. Show a => a -> String
show

instance PathPiece Int32 where
    fromPathPiece :: Text -> Maybe Int32
fromPathPiece = Text -> Maybe Int32
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Int32 -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Int32 -> String) -> Int32 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> String
forall a. Show a => a -> String
show

instance PathPiece Int64 where
    fromPathPiece :: Text -> Maybe Int64
fromPathPiece = Text -> Maybe Int64
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Int64 -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Int64 -> String) -> Int64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show

instance PathPiece Word where
    fromPathPiece :: Text -> Maybe Word
fromPathPiece = Text -> Maybe Word
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Word -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Word -> String) -> Word -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> String
forall a. Show a => a -> String
show

instance PathPiece Word8 where
    fromPathPiece :: Text -> Maybe Word8
fromPathPiece = Text -> Maybe Word8
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Word8 -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Word8 -> String) -> Word8 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> String
forall a. Show a => a -> String
show

instance PathPiece Word16 where
    fromPathPiece :: Text -> Maybe Word16
fromPathPiece = Text -> Maybe Word16
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Word16 -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Word16 -> String) -> Word16 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> String
forall a. Show a => a -> String
show

instance PathPiece Word32 where
    fromPathPiece :: Text -> Maybe Word32
fromPathPiece = Text -> Maybe Word32
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Word32 -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Word32 -> String) -> Word32 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show

instance PathPiece Word64 where
    fromPathPiece :: Text -> Maybe Word64
fromPathPiece = Text -> Maybe Word64
forall a. (Integral a, Bounded a, Ord a) => Text -> Maybe a
parseIntegral
    toPathPiece :: Word64 -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show

instance PathPiece Bool where
    fromPathPiece :: Text -> Maybe Bool
fromPathPiece Text
t =
        case ((Bool, String) -> Bool) -> [(Bool, String)] -> [(Bool, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> ((Bool, String) -> String) -> (Bool, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, String) -> String
forall a b. (a, b) -> b
snd) ([(Bool, String)] -> [(Bool, String)])
-> [(Bool, String)] -> [(Bool, String)]
forall a b. (a -> b) -> a -> b
$ ReadS Bool
forall a. Read a => ReadS a
reads ReadS Bool -> ReadS Bool
forall a b. (a -> b) -> a -> b
$ Text -> String
S.unpack Text
t of
            (Bool
a, String
s):[(Bool, String)]
_ -> Bool -> Maybe Bool -> Maybe Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
a)
            [(Bool, String)]
_        -> Maybe Bool
forall a. Maybe a
Nothing
    toPathPiece :: Bool -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Bool -> String) -> Bool -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show

instance PathPiece Day where
    fromPathPiece :: Text -> Maybe Day
fromPathPiece Text
t =
        case ReadS Day
forall a. Read a => ReadS a
reads ReadS Day -> ReadS Day
forall a b. (a -> b) -> a -> b
$ Text -> String
S.unpack Text
t of
            [(Day
a,String
"")] -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
a
            [(Day, String)]
_ -> Maybe Day
forall a. Maybe a
Nothing
    toPathPiece :: Day -> Text
toPathPiece = String -> Text
S.pack (String -> Text) -> (Day -> String) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
forall a. Show a => a -> String
show

instance (PathPiece a) => PathPiece (Maybe a) where
    fromPathPiece :: Text -> Maybe (Maybe a)
fromPathPiece Text
s = case Text -> Text -> Maybe Text
S.stripPrefix Text
"Just " Text
s of
        Just Text
r -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> Maybe a
forall s. PathPiece s => Text -> Maybe s
fromPathPiece Text
r
        Maybe Text
_ -> case Text
s of
            Text
"Nothing" -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
            Text
_ -> Maybe (Maybe a)
forall a. Maybe a
Nothing
    toPathPiece :: Maybe a -> Text
toPathPiece Maybe a
m = case Maybe a
m of
        Just a
s -> Text
"Just " Text -> Text -> Text
`S.append` a -> Text
forall s. PathPiece s => s -> Text
toPathPiece a
s
        Maybe a
_ -> Text
"Nothing"

class PathMultiPiece s where
    fromPathMultiPiece :: [S.Text] -> Maybe s
    toPathMultiPiece :: s -> [S.Text]

instance PathPiece a => PathMultiPiece [a] where
    fromPathMultiPiece :: [Text] -> Maybe [a]
fromPathMultiPiece = (Text -> Maybe a) -> [Text] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe a
forall s. PathPiece s => Text -> Maybe s
fromPathPiece
    toPathMultiPiece :: [a] -> [Text]
toPathMultiPiece = (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall s. PathPiece s => s -> Text
toPathPiece

-- | A function for helping generate free 'PathPiece'
--   instances for enumeration data types 
--   that have derived 'Read' and 'Show' instances.
--   Intended to be used like this:
--
--   > data MyData = Foo | Bar | Baz
--   >   deriving (Read,Show)
--   > instance PathPiece MyData where
--   >   fromPathPiece = readFromPathPiece
--   >   toPathPiece = showToPathPiece
--
--  Since 0.2.1. 
readFromPathPiece :: Read s => S.Text -> Maybe s
readFromPathPiece :: Text -> Maybe s
readFromPathPiece = String -> Maybe s
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe s) -> (Text -> String) -> Text -> Maybe s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
S.unpack

-- | See the documentation for 'readFromPathPiece'.
--
--  Since 0.2.1. 
showToPathPiece :: Show s => s -> S.Text
showToPathPiece :: s -> Text
showToPathPiece = String -> Text
S.pack (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show

{-# DEPRECATED toSinglePiece "Use toPathPiece instead of toSinglePiece" #-}
toSinglePiece :: PathPiece p => p -> S.Text
toSinglePiece :: p -> Text
toSinglePiece = p -> Text
forall s. PathPiece s => s -> Text
toPathPiece

{-# DEPRECATED fromSinglePiece "Use fromPathPiece instead of fromSinglePiece" #-}
fromSinglePiece :: PathPiece p => S.Text -> Maybe p
fromSinglePiece :: Text -> Maybe p
fromSinglePiece = Text -> Maybe p
forall s. PathPiece s => Text -> Maybe s
fromPathPiece

{-# DEPRECATED toMultiPiece "Use toPathMultiPiece instead of toMultiPiece" #-}
toMultiPiece :: PathMultiPiece ps => ps -> [S.Text]
toMultiPiece :: ps -> [Text]
toMultiPiece = ps -> [Text]
forall s. PathMultiPiece s => s -> [Text]
toPathMultiPiece

{-# DEPRECATED fromMultiPiece "Use fromPathMultiPiece instead of fromMultiPiece" #-}
fromMultiPiece :: PathMultiPiece ps => [S.Text] -> Maybe ps
fromMultiPiece :: [Text] -> Maybe ps
fromMultiPiece = [Text] -> Maybe ps
forall s. PathMultiPiece s => [Text] -> Maybe s
fromPathMultiPiece